home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / COMPRESS.ZIP / COMPMAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-02  |  22.8 KB  |  678 lines

  1. (*
  2.   CompDemo V2.0 for TCompress Components V2.0
  3.  
  4.   You are free to amend, adjust, improve, update, borrow, alter and muck about
  5.   with this demonstration program at will.
  6.  
  7.   However, if you redistribute the amended source together with the TCompress
  8.   components, please be sure to include ALL the files that came with it
  9.   (incl. Compress.hlp, Readme.txt and the ORIGINAL COMPDEMO source).  Thanks.
  10.  
  11.   Hint: To find the code which makes use of the TCompress components, search
  12.   for Compress1, CDBImage1 and CDBMemo1 references...
  13.  
  14.   USING THIS DEMO with Delphi V1.0:
  15.   1. Copy COMPDEMO.DPR, COMPMAIN.PAS and COMPMAIN.DFM to a new directory
  16.   2. Load Delphi 1.0, install Compress/Compctrl and load the new project
  17.   3. Ignore errors about Blobtype properties (not in Delphi 1.0)
  18.   4. In the CheckFile event handler, change the filepath type from string
  19.      (Delphi 2.0) to OpenString (Delphi 1.0). Don't forget to do this in
  20.      the method declaration as well as its implementation.
  21.   5. Compile and go.  Be aware that you'll need to add special filename
  22.      handling in Checkfile to deal with any archives compressed with Looong
  23.      (Win32/Delphi 2.0) filenames in them. Basically, just truncate to
  24.      a suitable 8.3 format name.
  25.  
  26.   Enjoy.
  27. *)
  28.  
  29. {$D-}   { Don't need debugging info, thanks... }
  30. unit Compmain;
  31.  
  32. interface
  33.  
  34. uses
  35.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  36.   Forms, Dialogs, Compress, StdCtrls, DB, DBTables, DBCtrls
  37.   ,CompCtrl, ExtCtrls, Buttons, FileCtrl, Mask;
  38.  
  39. type
  40.   TForm1 = class(TForm)
  41.     Table1: TTable;
  42.     DBNavigator1: TDBNavigator;
  43.     DataSource1: TDataSource;
  44.     Compress1: TCompress;
  45.     Table1SpeciesNo: TFloatField;
  46.     Table1Category: TStringField;
  47.     Table1Common_Name: TStringField;
  48.     Table1SpeciesName: TStringField;
  49.     Table1Lengthcm: TFloatField;
  50.     Table1Length_In: TFloatField;
  51.     CMethod: TRadioGroup;
  52.     Memo2: TMemo;
  53.     Shape1: TShape;
  54.     GroupBox1: TGroupBox;
  55.     FL: TFileListBox;
  56.     DL: TDirectoryListBox;
  57.     DCB: TDriveComboBox;
  58.     ArchiveGroup: TGroupBox;
  59.     ArchiveLabel: TLabel;
  60.     archivefile: TEdit;
  61.     Label2: TLabel;
  62.     ListBox1: TListBox;
  63.     Fishname: TDBEdit;
  64.     Memo4: TMemo;
  65.     Memo3: TMemo;
  66.     Memo5: TMemo;
  67.     Memo6: TMemo;
  68.     DBText1: TDBText;
  69.     Memo1: TMemo;
  70.     Button1: TButton;
  71.     Panel1: TPanel;
  72.     Bevel1: TBevel;
  73.     Time: TLabel;
  74.     Percentage: TLabel;
  75.     TimeLabel: TLabel;
  76.     Label7: TLabel;
  77.     Trashcan: TImage;
  78.     Image1: TImage;
  79.     Button2: TButton;
  80.     CDBImage1: TCDBImage;
  81.     CDBMemo1: TCDBMemo;
  82.     CDBImage1Graphic: TCGraphicField;
  83.     procedure CompressOneFile(var fname: String);
  84.     procedure ResetFileInfo;
  85.     function GetDir: string;
  86.     function GetDummyFilename(generatefrom: string; ext: string): string;
  87.     procedure handleDropField(Source: TObject; archivetoo: Boolean);
  88.     procedure CompressFiles;
  89.     function getCompressionMethod: TCompressionMethod;
  90.     procedure showInfo;
  91.     procedure FormCreate(Sender: TObject);
  92.     procedure showfiles;
  93.     procedure ExpandDelete(Operation: TCProcessMode; All: Boolean);
  94.     procedure archivefileChange(Sender: TObject);
  95.     procedure CMethodClick(Sender: TObject);
  96.     procedure DLDragOver(Sender, Source: TObject; X, Y: Integer;
  97.       State: TDragState; var Accept: Boolean);
  98.     procedure CDBImage1DragOver(Sender, Source: TObject; X, Y: Integer;
  99.       State: TDragState; var Accept: Boolean);
  100.     procedure CDBImage1DragDrop(Sender, Source: TObject; X, Y: Integer);
  101.     procedure CDBMemo1DragOver(Sender, Source: TObject; X, Y: Integer;
  102.       State: TDragState; var Accept: Boolean);
  103.     procedure CDBMemo1DragDrop(Sender, Source: TObject; X, Y: Integer);
  104.     procedure CDBImage1MouseDown(Sender: TObject; Button: TMouseButton;
  105.       Shift: TShiftState; X, Y: Integer);
  106.     procedure CDBMemo1MouseDown(Sender: TObject; Button: TMouseButton;
  107.       Shift: TShiftState; X, Y: Integer);
  108.     procedure archivefileDragOver(Sender, Source: TObject; X, Y: Integer;
  109.       State: TDragState; var Accept: Boolean);
  110.     procedure archivefileDragDrop(Sender, Source: TObject; X, Y: Integer);
  111.     procedure DLDragDrop(Sender, Source: TObject; X, Y: Integer);
  112.     procedure TrashcanDragDrop(Sender, Source: TObject; X, Y: Integer);
  113.     procedure FormDestroy(Sender: TObject);
  114.     procedure ListBox1Click(Sender: TObject);
  115.     procedure Table1AfterPost(DataSet: TDataset);
  116.     procedure Button1Click(Sender: TObject);
  117.     procedure FLClick(Sender: TObject);
  118.     procedure Compress1CheckFile(var filepath: String;
  119.       mode: TCProcessMode);
  120.     procedure Panel1Click(Sender: TObject);
  121.     procedure FormClick(Sender: TObject);
  122.     procedure GroupBox1Click(Sender: TObject);
  123.     procedure TrashcanDragOver(Sender, Source: TObject; X, Y: Integer;
  124.       State: TDragState; var Accept: Boolean);
  125.     procedure Button2Click(Sender: TObject);
  126.     procedure Compress1ShowProgress(PercentageDone: Longint);
  127.   private
  128.     { Private declarations }
  129.   public
  130.     { Public declarations }
  131.   end;
  132.  
  133. var
  134.   Form1: TForm1;
  135.  
  136. implementation
  137.  
  138. {$R *.DFM}
  139.  
  140. var FileList: TStringList; { holds information about our archive files }
  141.     saveCompressionMethod: Integer; { see ListBox1.click }
  142.  
  143. const ShowFileInfoColor :Tcolor = clGray; { see Listbox1.click }
  144.  
  145. { Example of accessing the TCompress performance properties }
  146. procedure Tform1.showinfo;
  147. begin
  148.    ResetFileInfo;
  149.    Time.caption:=Format('%-5.1fsecs',[Compress1.CompressionTime/1000.0]{[f]});
  150.    Percentage.caption:=IntToStr(Compress1.CompressedPercentage)+'%';
  151. end;
  152.  
  153. { Example of a progress event (new in TCompress 2.0) }
  154. procedure TForm1.Compress1ShowProgress(PercentageDone: Longint);
  155. begin
  156.    Percentage.caption:=IntToStr(PercentageDone)+'%';
  157. end; { you may have *other* uses for this every-8K-read event... }
  158.  
  159. { Example of getting a list of files in a multi-file archive }
  160. procedure TForm1.showfiles;
  161. begin
  162.   listbox1.clear;
  163.   FileList.clear;
  164.   if not FileExists(archivefile.Text) then exit;
  165.   Compress1.ScanCompressedFile(ArchiveFile.Text,Filelist);
  166.   ListBox1.Items.addStrings(FileList); { and File info objects are
  167.                             there too -- see ListBox1Click and FormDestroy }
  168. end;
  169.  
  170. { Example of expanding/deleting one or more files from a multi-file archive }
  171. procedure TForm1.ExpandDelete(Operation: TCProcessMode; All: Boolean);
  172. var s: Tstringlist;
  173.   count: Integer;
  174. begin
  175.   if (All and (Listbox1.Items.count > 0)) or (Listbox1.selcount>0) then { something is... }
  176.   begin
  177.      s:=Tstringlist.create;
  178.      try
  179.         if All then
  180.            s.addStrings(ListBox1.Items)
  181.         else
  182.            for count :=0 to Listbox1.ITems.count-1 do
  183.             if Listbox1.selected[count] then
  184.               s.add(Listbox1.items[count]);
  185.         if Operation=cmExpand then { expand }
  186.           compress1.expandfiles(ArchiveFile.Text,s)
  187.         else
  188.           compress1.deletefiles(ArchiveFile.Text,s);
  189.         showinfo;
  190.         showfiles; { also clears selections... }
  191.      finally
  192.         s.free;
  193.         Screen.Cursor := crDefault;
  194.      end;
  195.   end;
  196. end;
  197.  
  198. { Example of compressing a SINGLE file into an archive }
  199. procedure TForm1.CompressOneFile(var fname: String);
  200. begin
  201.   Compress1.CompressFile(ArchiveFile.Text,fname,getCompressionMethod);
  202.   showInfo;
  203.   showfiles;
  204.   Screen.Cursor := crDefault;
  205.   SysUtils.DeleteFile(fname); { because for this example we're creating TEMP files only... }
  206. end;
  207.  
  208. { Example of compressing MULTIPLE files into an archive }
  209. procedure TForm1.CompressFiles;
  210. var s: Tstringlist;
  211.     Count: Integer;
  212. begin
  213.   if FL.selcount>0 then { something is... }
  214.   begin
  215.     s:=TStringlist.Create;
  216.     try
  217.       for count :=0 to FL.Items.count-1 do
  218.         if FL.selected[count] then
  219.           s.add(FL.items[count]);
  220.       Compress1.CompressFiles(ArchiveFile.Text,s,getCompressionMethod);
  221.       showInfo;
  222.       showfiles;
  223.     finally;
  224.        s.free;
  225.        Screen.Cursor := crDefault;
  226.     end;
  227.   end;
  228. end;
  229.  
  230. { Examples of setting/loading/shifting image blobs }
  231. procedure TForm1.CDBImage1DragDrop(Sender, Source: TObject; X, Y: Integer);
  232. var filepath: String;
  233.      mem: TMemoryStream; { for loading image from an archived file }
  234. begin
  235.    if Source=Sender then exit; { nowt to do }
  236.    if (Sender is TCDBImage) and (not Table1.active) then
  237.    begin
  238.      showmessage('Can''t do this unless table has been opened...');
  239.      exit;
  240.    end;
  241.  
  242.   Screen.Cursor:= crHourGlass;
  243.   if (Source = Image1) and (Sender is TCDBImage) then
  244.      CDBImage1.picture.bitmap.Assign(Image1.Picture.bitmap)
  245.   else if (Source is TCDBImage) and (Sender = Image1) then
  246.      Image1.picture.bitmap.Assign(CDBImage1.Picture.Bitmap)
  247.   else
  248.   begin   { Have we got an image? }
  249.      filepath := '';
  250.      if (Source is TListBox) and (Listbox1.selcount = 1) then
  251.       filepath:=ListBox1.Items[Listbox1.ItemIndex] { archive list }
  252.      else if (Source is TFileListBox) and (FL.selcount=1) then
  253.         filepath:=FL.Items[FL.ItemIndex]; { file list }
  254.      if LowerCase(ExtractFileExt(filepath))<>'.bmp' then
  255.      begin
  256.         MessageBeep(1);
  257.         showmessage('Must be a .BMP file...')
  258.      end else begin                             { ok, here we go... }
  259.         if Source is TListBox then { must first extract file... }
  260.         begin { Note: Registered users will get the source of two FASTER ways
  261.                                 of going about this (no expanded file needed) }
  262.           Compress1.ExpandFile(filepath,ArchiveFile.Text);
  263.           Screen.cursor := crDefault; { as our OnCheckFile sets it on }
  264.           if filepath='' then exit; { was skipped on confirmation }
  265.         end;
  266.         Screen.Cursor:= crHourGlass;
  267.         if Sender = Image1 then
  268.            Image1.Picture.Bitmap.LoadFromfile(filepath)
  269.         else
  270.            CDBImage1.Picture.Bitmap.LoadFromFile(filepath);
  271.      end; { else }
  272.   end;
  273.   if Table1.active and (Table1.State in [dsEdit]) then Table1.post; { save immediately if updated }
  274.   if not Image1.Picture.Bitmap.Empty then Memo1.visible := False; { got a piccy showing... }
  275.   Screen.Cursor:= crDefault;
  276. end;
  277.  
  278. { Examples of setting/loading/shifting CDBMemo blobs }
  279. procedure TForm1.CDBMemo1DragDrop(Sender, Source: TObject; X, Y: Integer);
  280. var filepath: String;
  281.      f: Tfilestream;
  282.      mem: TMemoryStream; { for loading text from an archived file }
  283. begin
  284.  
  285.   filepath := ''; { in case fails }
  286.   if (Source is TListBox) and (Listbox1.selcount = 1) then
  287.    filepath:=ListBox1.Items[Listbox1.ItemIndex] { archive list }
  288.   else if (Source is TFileListBox) and (FL.selcount=1) then
  289.      filepath:=FL.Items[FL.ItemIndex]; { file list }
  290.   if LowerCase(ExtractFileExt(filepath))<>'.txt' then
  291.   begin
  292.     MessageBeep(1);
  293.     showmessage('Must be a .TXT file...')
  294.   end else begin                             { ok, here we go... }
  295.     if Source is TListBox then { must first extract file... }
  296.     begin { Note: Registered users will get the source of two FASTER ways
  297.                             of going about this (no expanded file needed) }
  298.       Compress1.ExpandFile(filepath,ArchiveFile.Text);
  299.       Screen.cursor := crDefault; { as our OnCheckFile sets it on }
  300.       if filepath='' then exit; { was skipped on confirmation }
  301.     end;
  302.     Screen.Cursor:= crHourGlass;
  303.     CDBMemo1.Lines.LoadfromFile(filepath)
  304.   end;
  305.   if Table1.active and (Table1.State in [dsEdit]) then Table1.post; { save immediately }
  306.   Screen.Cursor:= crDefault;
  307. end;
  308.  
  309. procedure TForm1.CDBMemo1DragOver(Sender, Source: TObject; X, Y: Integer;
  310.   State: TDragState; var Accept: Boolean);
  311. begin
  312.   accept := (Source is TFileListBox) or (Source is TListBox);
  313. end;
  314.  
  315. procedure TForm1.CDBImage1DragOver(Sender, Source: TObject; X, Y: Integer;
  316.   State: TDragState; var Accept: Boolean);
  317. begin
  318.   accept := (Source=Image1) or (Source is TCDBImage) or
  319.      (Source is TFileListBox) or (Source is TListBox);
  320. end;
  321.  
  322. { Refreshing a CDBImage so it will be compressed (assuming previously uncompressed) }
  323. procedure TForm1.CDBImage1MouseDown(Sender: TObject; Button: TMouseButton;
  324.   Shift: TShiftState; X, Y: Integer);
  325. begin
  326.   if Button=mbRight then { ok, refresh our field }
  327.   begin
  328.      CDBImage1.CopyToClipBoard;
  329.      CDBImage1.PasteFromClipBoard;
  330.      Table1.post;
  331.   end;
  332. end;
  333.  
  334. procedure TForm1.CDBMemo1MouseDown(Sender: TObject; Button: TMouseButton;
  335.   Shift: TShiftState; X, Y: Integer);
  336. begin
  337.   if Button=mbRight then { ok, refresh our field }
  338.   begin
  339.      CDBMemo1.Lines[0]:=CDBMemo1.Lines[0]; { setting .Modified doesn't do it... }
  340.      Table1.post;
  341.   end;
  342.  
  343. end;
  344.  
  345. procedure TForm1.CMethodClick(Sender: TObject);
  346. begin
  347.   CDBIMage1.CompressionMethod := getCompressionMethod;
  348.   CDBMemo1.CompressionMethod := getCompressionMethod;
  349. end;
  350.  
  351. procedure TForm1.FormCreate(Sender: TObject);
  352. begin
  353.  
  354.  fileList := TStringList.create; { keeps track of our archive files for display etc. }
  355.  SendMessage(ListBox1.handle,LB_SetHorizontalExtent,300,LongInt(0));
  356.  saveCompressionMethod := -1; { see Listbox1.click }
  357.  showfiles; { show files in archive (if any)... }
  358.  try
  359. {$IFDEF WINDOWS}
  360.    DL.Directory := '\DELPHI\IMAGES\BACKGRND';
  361. {$ENDIF}
  362. {$IFDEF WIN32}
  363.    DL.Directory := '\Program Files\Borland\Delphi 2.0\IMAGES\BACKGRND';
  364. {$ENDIF}
  365.  except on EInOutError do ; { nowt, let it default }
  366.  end;
  367.  
  368.  try Table1.Active := True;
  369.      DataSource1.Edit;
  370.  except
  371.   on EDBEngineError do
  372.      showmessage('The BLOB compression portion of this demonstration'+#13+
  373.                  'requires that the DBDEMOS alias be set up and pointing'+#13+
  374.                  'to the BIOLIFE.DB table in \DELPHI\DEMOS\DATA.'+#13+#13+
  375.                  '-- as this is not currently the case, the BLOB demonstration'+#13+
  376.                  'is disabled.');
  377.   on EUnrecognizedCompressionMethod do
  378.      showmessage('Your BIOLIFE database appears to have been compressed with'+#13+
  379.                  'a custom compression method which cannot be recognised.'+#13+
  380.                  'Please revert to an uncompressed backup of BIOLIFE.*');
  381.  end; {try }
  382.  
  383.  if not Table1.Active then { something went wrong... }
  384.  begin
  385.      CDBImage1.visible:=False;
  386.      CDBMemo1.visible:=False;
  387.      DBNavigator1.visible:=False;
  388.      Memo1.visible:=False;
  389.      Memo2.visible := True;
  390.  end;
  391.  CMethodClick(self);  { get default compression for our database controls }
  392.  
  393. end;
  394.  
  395. function TForm1.GetDir: string; { called below and in GetDummyFileName }
  396. begin
  397.   Result := DL.Directory;
  398.   if Copy(Result,Length(Result),1)<>'\' then { not already \'d? }
  399.     Result := Result+'\';
  400. end;
  401.  
  402. procedure TForm1.archivefileChange(Sender: TObject);
  403. begin
  404.   showfiles;
  405. end;
  406.  
  407. function TForm1.getCompressionMethod: TCompressionMethod;
  408. begin
  409.    result := coNone; { default }
  410.    case CMethod.ItemIndex of
  411.      1: result := coRLE;
  412.      2: result := coLZH;
  413.    end;
  414. end;
  415.  
  416. procedure TForm1.DLDragOver(Sender, Source: TObject; X, Y: Integer;
  417.   State: TDragState; var Accept: Boolean);
  418. begin
  419.   accept := True;
  420.   if ((Sender is TDirectoryListBox) and (Source is TFileListBox)) or
  421.      (Source=Trashcan) then
  422.         accept := False; { fair enough? }
  423. end;
  424.  
  425. procedure TForm1.archivefileDragOver(Sender, Source: TObject; X,
  426.   Y: Integer; State: TDragState; var Accept: Boolean);
  427. begin
  428.   accept := True; { but... }
  429.   if ((Source is TGroupBox) and not (Sender is TGroupBox)) or
  430.          (((Sender is TEdit)or (Sender is TGroupBox)) and (Source is TListBox)) or { not from our OWN list }
  431.            (Source=Trashcan) then
  432.      accept := False;
  433. end;
  434.  
  435. { Used to create 'work' filenames for saving images and memos
  436.   from the database into our archive or to disk... }
  437. function TForm1.GetDummyFilename(generatefrom: string; ext: string): string;
  438. var spos:Integer;
  439. begin
  440.   if (generatefrom='Image') or (generateFrom='') then
  441.      generatefrom:='image'
  442.   else
  443.   begin
  444. {$IFDEF WINDOWS}
  445.      generatefrom := copy(generatefrom,1,8); { max 8 }
  446.      spos:=pos(' ',generateFrom);
  447.      while spos >0 do { eliminate spaces }
  448.      begin
  449.         delete(generatefrom,spos,1);
  450.        spos:=pos(' ',generateFrom);
  451.      end;
  452. {$ENDIF}     
  453.   end;
  454.   result := AnsiLowerCase(Getdir+generatefrom+'.'+ext);
  455. end;
  456.  
  457. function Confirmfilename(filename: String; archiving: Boolean): Boolean;
  458. var dlg: Integer;
  459. begin
  460.   Result := True; { default for archiving }
  461.   if (not Archiving) and
  462.      (MessageDlg('Save to '+filename+'?', mtConfirmation,[mbYes, mbNo], 0)<>id_Yes) then
  463.      Result := False;
  464. end;
  465.  
  466. { The handler for dropping things on the file list or archive list }
  467. procedure TForm1.handleDropField(Source: TObject; archivetoo: Boolean);
  468. var filename: String;
  469. begin
  470.   filename := ''; { in case it is NOT one of those below... }
  471.   if Source is TCDBMemo then
  472.   begin
  473.      filename := GetDummyFilename(Fishname.Text,'TXT');
  474.      if not confirmFilename(filename,archivetoo) then exit;
  475.      CDBMemo1.Lines.SaveToFile(filename);
  476.   end else if Source is TCDBImage then
  477.   begin
  478.      filename := GetDummyFilename(Fishname.Text,'BMP');
  479.      if not confirmFilename(filename,Archivetoo) then exit;
  480.      CDBImage1.Picture.Bitmap.SaveToFile(filename);
  481.   end
  482.   else
  483.    if Source = Image1 then
  484.   begin
  485.      filename := GetDummyFilename('Image','BMP');
  486.      if not confirmFilename(filename,Archivetoo) then exit;
  487.      Image1.Picture.Bitmap.SaveToFile(filename);
  488.   end;
  489.   if (filename<>'') and (ArchiveToo) then
  490.       CompressOneFile(filename);
  491. end;
  492.  
  493.  
  494. procedure TForm1.archivefileDragDrop(Sender, Source: TObject; X,
  495.   Y: Integer);
  496. begin
  497.   if Source is TFileListBox then
  498.      CompressFiles
  499.   else
  500.     HandleDropField(Source, True); { save to temp file AND archive... }
  501. end;
  502.  
  503. procedure TForm1.DLDragDrop(Sender, Source: TObject; X, Y: Integer);
  504. var dlg: Integer;
  505. begin
  506.   if Source=Sender then exit; { seems reasonable, and IS necessary }
  507.   if Source is TListBox then
  508.     ExpandDelete(cmExpand,False) { selected archive files }
  509.   else if Source=ArchiveGroup then
  510.      ExpandDelete(cmExpand,True) { all archived files }
  511.   else
  512.     HandleDropField(Source, False); { save field to a file }
  513.   FL.Update; { get up to date... }
  514. end;
  515. procedure TForm1.TrashcanDragDrop(Sender, Source: TObject; X, Y: Integer);
  516. var count: Integer;
  517.     tempBitmap: TBitMap; { just to get an empty one }
  518. begin
  519.   if Source is TListBox then
  520.     ExpandDelete(cmDelete,False)
  521.   else if Source=ArchiveGroup then
  522.      ExpandDelete(cmDelete,True) { all files }
  523.      { and strictly speaking, should now delete the archive if it is
  524.        empty, but I'll leave that as an exercise... }
  525.   else if Source is TFileListBox then { delete some or all... }
  526.   begin
  527.      for count:=0 to FL.Items.count-1 do
  528.         if FL.selected[count] and
  529.            (MessageDlg('Delete '+GetDir+FL.Items[count],mtConfirmation,[mbYes,mbNo],0)=id_Yes) then
  530.            SysUtils.DeleteFile(GetDir+FL.Items[count]);
  531.      FL.Update;
  532.   end
  533.   else if (Source is TCDBMemo) and
  534.               (MessageDlg('Cut to clipboard?',mtConfirmation,[mbYes,mbNo],0)=id_Yes) then
  535.   begin
  536.      CDBMemo1.SelectAll;
  537.      CDBMemo1.cutToClipboard { safer than .clear, for demo purposes }
  538.   end
  539.   else if (Source is TCDBImage) and
  540.             (MessageDlg('Cut to clipboard?',mtConfirmation,[mbYes,mbNo],0)=id_Yes) then
  541.       CDBImage1.cutToClipboard { not quite a delete, but just for example... }
  542.   else if Source=Image1 then
  543.   begin
  544.      tempBitMap := TBitMap.Create;
  545.      try
  546.         Image1.Picture.Bitmap.Assign(tempBitMap);
  547.         Memo1.visible := True
  548.      finally
  549.         tempBitMap.free;
  550.      end;
  551.   end;
  552.  
  553.  
  554. end;
  555.  
  556. procedure TForm1.FormDestroy(Sender: TObject);
  557. var count: Integer;
  558. begin
  559.   if FileList<> nil then
  560.     for count:= 0 to FileList.count-1 do
  561.      Filelist.objects[count].free; { get rid of these (if any)... }
  562.   FileList.free; { and the list itself }
  563. end;
  564.  
  565.  
  566. procedure TForm1.ListBox1Click(Sender: TObject);
  567. var cfinfo: TCompressedFileInfo;
  568. begin
  569.   if listBox1.ItemIndex >=0 then
  570.   begin
  571.      CMethod.Color := ShowFileInfoColor; { make it clear we are showing off a bit... }
  572.      Percentage.Color := ShowFileInfoColor;
  573.      Time.Color := ShowFileInfoColor;
  574.      TimeLabel.Caption := 'Full Size:';
  575.  
  576.      cfinfo:=TCompressedFileinfo(FileList.objects[listBox1.ItemIndex]); { how to get at the other stuff... }
  577.      if cfinfo.Fullsize>0 then
  578.        Percentage.caption:=IntToStr(100-100*cfinfo.CompressedSize div cfinfo.Fullsize)+'%'
  579.      else
  580.        Percentage.caption:='(empty)';
  581.      Time.caption:= IntToStr((512+cfinfo.Fullsize) div 1024)+' Kb';
  582.      if saveCompressionMethod <0 then
  583.         savecompressionMethod :=cMethod.ItemIndex;
  584.      cMethod.ItemIndex :=Integer(cfinfo.CompressedMode);
  585.   end;
  586. end;
  587.  
  588. procedure TForm1.ResetFileInfo;
  589. begin
  590.   if saveCompressionMethod <0 then exit;
  591.   cMethod.ItemIndex:=savecompressionMethod;
  592.   saveCompressionMethod := -1;
  593.   CMethod.Color := clBtnFace;
  594.   Percentage.Color := clWindow;
  595.   Time.Color := clWindow;
  596.   TimeLabel.Caption := 'Time:';
  597.   showInfo; { get the right stuff too... }
  598.   Time.Caption:=''; { but this is meaningless at this point... }
  599. end;
  600.  
  601.  
  602. procedure TForm1.Table1AfterPost(DataSet: TDataset);
  603. begin
  604.   Showinfo;
  605. end;
  606.  
  607. procedure TForm1.Button1Click(Sender: TObject);
  608. begin
  609.   ShowMessage('Drag and Drop at will: compression and expansion'+#13+
  610.   'is automatic.'+#13+#13+
  611.   'Uses TCompress, TCDBMemo and TCDBImage.'+#13+#13+
  612.   'Component Registration and License: $NZ65 (appr. $US45)'+#13+
  613.   'South Pacific Information Services Ltd'+#13+
  614.   'Fax: +64-3-384-5138   Email: peter@spis.co.nz');
  615. end;
  616.  
  617. procedure TForm1.FLClick(Sender: TObject);
  618. begin
  619.   ResetFileInfo;
  620. end;
  621.  
  622. { Example of OnCheckFile user interface handling routine }
  623. procedure TForm1.Compress1CheckFile(var filepath: String;
  624.   mode: TCProcessMode);
  625. var modestr: String;
  626.   dlg: Integer;
  627. begin
  628.   case mode of
  629.      cmExpand: begin
  630.                  modestr := 'Expand';
  631.                  filepath:=Getdir+extractfilename(filepath); { go where we should }
  632.                end;
  633.      cmCompress: begin
  634.                     modestr := 'Compress';
  635.                     filepath:={Getdir+}extractfilename(filepath); { use GetDir if you want full path... }
  636.                  end;
  637.      cmDelete: modestr := 'Delete';
  638.   end;
  639.   showInfo;
  640.   Screen.cursor := crDefault; { in case this is second call in a sequence }
  641.   dlg := MessageDlg(modestr+' '+filepath+'?', mtConfirmation,[mbYes, mbNo, mbCancel], 0);
  642.   case dlg of
  643.      id_No: filepath :=CompressSkipFlag; { flag 'not this one'}
  644.      id_Cancel: filepath :=CompressNoMoreFlag; { flag 'no more!' }
  645.      id_Yes: Screen.Cursor := crHourGlass; { for operation itself }
  646.   end;
  647. end;
  648.  
  649.  
  650.  
  651. procedure TForm1.Panel1Click(Sender: TObject);
  652. begin
  653. ResetFileInfo;
  654. end;
  655.  
  656. procedure TForm1.FormClick(Sender: TObject);
  657. begin
  658. ResetFileInfo;
  659. end;
  660.  
  661. procedure TForm1.GroupBox1Click(Sender: TObject);
  662. begin
  663. ResetFileInfo;
  664. end;
  665.  
  666. procedure TForm1.TrashcanDragOver(Sender, Source: TObject; X, Y: Integer;
  667.   State: TDragState; var Accept: Boolean);
  668. begin
  669.   accept := True;
  670. end;
  671.  
  672. procedure TForm1.Button2Click(Sender: TObject);
  673. begin
  674. Application.HelpFile:='COMPRESS.HLP';
  675. Application.HelpJump('1050');
  676. end;
  677. end.
  678.